#lang plai/collector

(define (init-allocator)
  (begin
    (set-heap-free 0 1)))


;Contract : get-heap-size : empty -> int
;Purpose: Returns the upper boundary of the free list indices
(define (get-heap-size)
  (floor (/ (heap-size) 4)))

;Contract : translate-free : integer -> integer
;Purpose: Accepts a free address location and returns the corresponding data address
(define (translate-free free-address)
  (+ (* free-address 3) (get-heap-size)))

;Contract: translate-address : integer -> integer
;Purpose: Accepts a data address location and returns the corresponding free address
(define (translate-address address)
  (/ (- address (get-heap-size)) 3))

(define (gc:alloc-flat p)
  (begin
    (define free-pos (heap-has-free 0))
    (define free-address (translate-free free-pos))
    (if (> free-pos (- (get-heap-size) 1))
        (begin
          (mark-and-sweep)
          (if (> (heap-has-free 0) (- (get-heap-size) 1))
              (error 'gc:flat "out of memory")
              (gc:alloc-flat p)))
        (begin
          (heap-set! free-address 'prim)
          (heap-set! (+ 1 free-address) p)
          (heap-set! (+ 2 free-address) empty)
          (heap-set! free-pos 0)
          free-address))))

(define (gc:cons f r)
  (begin
    (define free-pos (heap-has-free 0))
    (define free-address (translate-free free-pos))
    (if (> free-pos (- (get-heap-size) 1))
        (begin
          (mark-and-sweep)
          (if (> (heap-has-free 0) (- (get-heap-size) 1))
              (error 'gc:cons "out of memory")
              (gc:cons f r)))
        (begin
          (heap-set! free-address 'cons)
          (heap-set! (+ 1 free-address) f)
          (heap-set! (+ 2 free-address) r)
          (heap-set! free-pos 0)
          free-address))))


;Contract : heap-has-free : integer -> integer
;Purpose: Accepts a beginning location to scan and returns the first index with a free location. 
;         If no free location is found, a value outside the range is returned
(define (heap-has-free pos)
  (if (> pos (- (get-heap-size) 1))
      pos
      (if (eq? (heap-ref pos) 1)
          pos
          (heap-has-free (+ pos 1)))))


(define (gc:cons? a)
  (eq? (heap-ref a) 'cons))

(define (gc:first a)
  (heap-ref (+ 1 a)))

(define (gc:rest a)
  (heap-ref (+ 2 a)))

(define (gc:set-first! a f)
  (if (gc:cons? a)
      (heap-set! (+ 1 a) f)
      (error 'set-first! "expects address of cons")))

(define (gc:set-rest! a r)
  (heap-set! (+ 2 a) r))

(define (gc:flat? a)
  (eq? (heap-ref a) 'prim))

(define (gc:deref a)
  (heap-ref (+ 1 a)))


;Contract: set-heap-free : (integer integer) -> nothing
;Purpose: accepts a starting position and a value and sets all free locations starting with the given position to
;         the given value
(define (set-heap-free pos free)
  (if (< pos (get-heap-size))
      (begin
        (heap-set! pos free)
        (set-heap-free (+ pos 1) free))
      empty))

;Contract: mark-and-sweep : nothing -> nothing
;Purpose: Marks all locations in the free list that are no longer being used allowing for future usage
(define (mark-and-sweep)
  (begin
    (set-heap-free 0 1)
    (for/list ([root (get-root-set)])
        (mark (read-root root)))))

;Contract: mark : integer -> nothing
;Purpose: Accepts an address in memory and marks the corresponding free address as free
(define (mark address)
  (cond
    [(gc:flat? address)
     (begin
       (heap-set! (translate-address address) 0)
       )]
    [(gc:cons? address)
     (begin
       (heap-set! (translate-address address) 0)
       (mark (gc:first address))
       (mark (gc:rest address)))]))

